;
;	DICCRE	V2.0			March 21, 1983
;
;		written by Michael C. Adler
;
;	Creates a dictionary file DICT.DIC and a pointer file SPELL0.MAC
; from dictionary source files.  Flags are converted into bit values and
; characters are stored in 5-bit.
;
; Modification history:
;
;	V1.0 - August 16, 1982:  Created.
;
;	V2.0 - March 21, 1983:
;		Added code to print double ' for words with apostrophes listed
;		in SPELL0.MAC.
;

	TITLE	DICCRE

	.Z80
;	JP	START

	DB	'(C) 1983 Michael C. Adler. '
	DB	'This program has been released into the public domain '
	DB	'by the author.  It may neither be sold for profit nor '
	DB	'included in a sold software package without permission '
	DB	'of the author.'

BOOT	EQU	0000H
BDOS	EQU	0005H
IFCB	EQU	005CH
STROUT	EQU	9
OPEN	EQU	15
CLOSE	EQU	16
DELETE	EQU	19
READ	EQU	20
WRITE	EQU	21
MAKE	EQU	22
RENAME	EQU	23
SETDMA	EQU	26			;SET DMA ADDRESS
RANREA	EQU	33			;READ RANDOM

LF	EQU	10
CR	EQU	13
EOF	EQU	01AH			;END OF FILE CHARACTER
QUOTE	EQU	027H			;"'"
;
;	The following are bit flags for the dictionary
;
ZFLAG	EQU	1
YFLAG	EQU	2
RFLAG	EQU	4
GFLAG	EQU	8
DFLAG	EQU	16
MFLAG	EQU	32
SFLAG	EQU	64
HFLAG	EQU	256
VFLAG	EQU	512
JFLAG	EQU	1024
XFLAG	EQU	2048
TFLAG	EQU	4096
NFLAG	EQU	8192
PFLAG	EQU	16384



START:	LD	SP,STACK		;CREATE A STACK
	LD	DE,WELCOM		;PRINT SIGNON MESSAGE
	LD	C,STROUT
	CALL	BDOS
	JR	HIDONE
WELCOM:	DB	'DICCRE V2.0 -- March 21, 1983',CR,LF
	DB	'(C) 1983 Michael C. Adler',CR,LF,'$'

HIDONE:	LD	A,EOF			;MARK EOF FOR BUFFERS
	LD	(OBUFF+512),A
	LD	(INBUF+512),A
	LD	(INBUF+513),A
	LD	A,(BOOT+06CH)		;GET DRIVE FOR OUTPUT FILES
	LD	(OFCB),A
	LD	(DICFCB),A
	LD	A,0C9H			;RETURN INSTRUCTION
	LD	(100H),A		;THIS PROGRAM IS CAN NOT BE GOED
	LD	DE,IFCB			;OPEN INPUT FILE
	LD	C,OPEN
	CALL	BDOS
	CP	0FFH			;FILE FOUND?
	JR	NZ,START0
	LD	DE,NOTFOU		;ERROR
	LD	C,STROUT
	CALL	BDOS
	CALL	BOOT
NOTFOU:	DB	'Input file not found',CR,LF,'$'

START0:	LD	DE,DICFCB
	LD	C,OPEN
	CALL	BDOS
	CP	0FFH			;DOES "DICT.DIC" ALREADY EXIST?
	JR	Z,START1		;IF NOT, CONTINUE
	LD	DE,EXDIC		;DELETE DICT.DIC MESSAGE
	LD	C,STROUT
	CALL	BDOS
	CALL	YESNO			;ASK WHETHER DELETE IT
	CALL	NZ,BOOT			;DON'T RUN IF DON'T DELETE
	LD	DE,DICFCB
	LD	C,DELETE
	CALL	BDOS
START1:	LD	DE,DICFCB
	LD	C,MAKE
	CALL	BDOS
	LD	DE,OFCB
	LD	C,OPEN			;DOES "SPELL0.MAC" EXIST?
	CALL	BDOS
	CP	0FFH
	JR	Z,START2		;IF NOT, CONTINUE
	LD	DE,EXSPEL		;DELETE SPELL0.MAC MESSAGE
	LD	C,STROUT
	CALL	BDOS
	CALL	YESNO			;ASK WHETHER DELETE IT
	CALL	NZ,BOOT			;DON'T RUN IF SAVE FILE
	LD	DE,OFCB
	LD	C,DELETE
	CALL	BDOS
START2:	LD	DE,OFCB
	LD	C,MAKE
	CALL	BDOS

	CALL	CTRLZ			;PUT ^Z IN OBUFF
	LD	A,01AH			;ALSO AT END OF IT
	LD	(OBUFF+512),A
	CALL	DICZER			;ZERO DICTIONARY BUFFER
	LD	HL,TABTOP		;CHARACTER STRING FOR TABTOP::
	LD	B,8			;OUTPUT 10 CHARACTERS
LOOP:	LD	A,(HL)
	CALL	PUTCHR
	INC	HL
	DJNZ	LOOP
	CALL	GETWRD			;GET THE FIRST WORD
	LD	A,0			;END OF FILE?  UNLIKELY!
	CP	C
	CALL	Z,BOOT
	LD	B,C
	LD	C,0
	CALL	MAKTBL			;PUT WORD IN RECORD TABLE
	JR	MAINSK
MAIN:	CALL	GETWRD			;GET A WORD
	LD	A,0			;IF 0 LENGTH WORD THEN END
	CP	C
	JP	Z,DONE
	LD	B,C			;PUT NUMBER OF CHARACTERS READ IN B
	LD	C,0			;ZERO COUNTER
MAINSK:	LD	HL,SRCWRD
	LD	DE,OLDWRD
MAIN0:	LD	A,(DE)			;COMPARE THIS WORD TO LAST (GET # OF
					;SIMILAR CHARACTERS)
	CP	(HL)
	JR	NZ,MAIN1
	INC	DE
	INC	HL
	INC	C
	JR	MAIN0
MAIN1:	LD	A,15			;MAY COPY MAXIMUM OF 15 CHARACTERS
	CP	C
	JP	NC,MAIN2		;JUMP IF LESS THAN 15
	LD	C,15
	LD	HL,SRCWRD+15		;POINT TO 1ST CHARACTER TO USE
MAIN2:	PUSH	BC			;COMPUTE NUMBER OF BITS IN WORD
	LD	A,B			;COMPUTE NUMBER OF CHARACTERS IN WORD-
					;NUMBER TO COPY
	SUB	C
	LD	B,A
	LD	A,0
MAIN3:	ADD	A,5			;5 BITS PER LETTER
	DJNZ	MAIN3
	POP	BC
	ADD	A,25			;4 BITS FOR COPY AMOUNT
					;14 BITS FOR STATUS FLAGS
					;4 BITS FOR LENGTH OF STATUS FLAGS
					;3 BITS FOR END OF WORD
	PUSH	DE
	PUSH	HL
	LD	HL,(BITS)		;NUMBER OF BITS LEFT IN 256 BYTE RECORD
	LD	E,A			;PUT BITS IN THIS WORD IN DE
	LD	D,0
	XOR	A			;CLEAR CARRY
	SBC	HL,DE			;NUMBER OF BITS LEFT AFTER THIS
	JP	NC,MAIN4		;JUMP IF WORD WILL FIT
	CALL	DWRITE			;WRITE THIS RECORD
	CALL	DICZER			;ZERO DICTIONARY BUFFER
	LD	C,0			;BEGINNING OF RECORD.  COPY 0
	CALL	MAKTBL			;WRITE TO TABLE FILE
	LD	HL,2048			;NUMBER OF BITS IN 256 BYTES
	LD	(BITS),HL		;RESET COUNTER
	POP	HL
	POP	DE
	LD	HL,SRCWRD
	JP	MAIN2			;RECALCULATE LENGTH OF WORD
MAIN4:	LD	(BITS),HL
	POP	HL
	POP	DE
	PUSH	BC
	PUSH	HL
	LD	C,B			;NUMBER OF CHARACTERS IN SRCWRD TO BC
	LD	B,0
	LD	HL,SRCWRD		;PUT SRCWRD IN OLDWRD
	LD	DE,OLDWRD
	LDIR
	LD	A,1
	LD	(DE),A			;MARK END OF WORD
	POP	HL
	POP	BC
	CALL	BUFWRD			;BUFFER WORD IN RECORD
	JP	MAIN			;GET NEXT WORD

DONE:	LD	A,(IFCB)		;IF INPUT FILE ON DIFFERENT DISK THAN
					;OUTPUT FILE, ASK IF MORE
	LD	HL,OFCB
	CP	(HL)
	JR	Z,ENDIT
	LD	DE,MOREST		;MORE QUESTION
	LD	C,STROUT
	CALL	BDOS
	LD	HL,INBUF+512		;GET PREPARED IN CASE MORE
	LD	(INPTR),HL
	CALL	YESNO
	JR	NZ,NOMORE		;END IF NO MORE
	LD	HL,IFCB+0CH		;CLEAR THE IFCB RECORD POINTERS
	LD	B,23
	LD	A,0
DONF:	LD	(HL),A
	INC	HL
	DJNZ	DONF
	LD	DE,IFCB			;OPEN THE FILE
	LD	C,OPEN
	CALL	BDOS
	CP	0FFH			;FOUND?
	JP	NZ,MAIN			;GET NEXT WORD
	LD	DE,NOTFOU		;NOT FOUND MESSAGE
	LD	C,STROUT
	CALL	BDOS
NOMORE:	LD	A,(IFCB)		;IS IT ON DRIVE OTHER THAN A?
	CP	2
	JP	P,ENDIT			;JUST BOOT IF SO
	LD	DE,TYPECR		;MESSAGE:  INSERT BOOTABLE DISK...
	LD	C,STROUT
	CALL	BDOS
	LD	DE,BOOT+80H		;WAIT FOR A LINE FROM TERMINAL
	LD	C,0AH
	CALL	BDOS
ENDIT:	LD	HL,TBTSTR		;"TABBOT::"
	LD	B,24			;12 CHARACTERS WITH CR,LF
DONE0:	LD	A,(HL)			;GET THE CHARACTER
	INC	HL
	CALL	PUTCHR
	DJNZ	DONE0
	LD	HL,OBUFF		;WRITE OUT REMAINING DATA IN BUFFER
	LD	DE,128
DONE1:	LD	A,EOF			;DONE?
	CP	(HL)
	JR	Z,DONE3
	PUSH	DE
	PUSH	HL
	LD	D,H			;SET UP DMA ADDRESS
	LD	E,L
	LD	C,SETDMA
	CALL	BDOS
	LD	DE,OFCB			;WRITE 128 BYTES TO FILE
	LD	C,WRITE
	CALL	BDOS
	POP	HL
	POP	DE
	CP	0			;ERROR?
	JR	NZ,DONE2		;DISK FULL --> BRANCH
	ADD	HL,DE			;POINT TO NEXT RECORD
	JR	DONE1
DONE2:	LD	C,STROUT		;DISK FULL
	LD	DE,DSKFUL		;DISK FULL MESSAGE (SEE PUTCHR)
	CALL	BDOS
	CALL	BOOT

DONE3:	LD	DE,OFCB			;CLOSE OUTPUT FILE
	LD	C,CLOSE
	CALL	BDOS
	LD	HL,(CURBYT)		;SEE IF DATA LEFT IN DICTIONARY REC
	LD	BC,DICBUF-1
	XOR	A			;CLEAR CARRY
	SBC	HL,BC
	JR	Z,DONE4			;DON'T WRITE IF NO DATA
	CALL	DWRITE			;WRITE OUT CURRENT DICTIONARY RECORD
DONE4:	LD	DE,DICFCB		;CLOSE FILE
	LD	C,CLOSE
	CALL	BDOS
	CALL	BOOT

BUFWRD:	RRC	C			;OUTPUT NUMBER OF BYTES TO COPY
	RRC	C
	RRC	C	
	RRC	C
	LD	B,4			;SEND 4 BITS
BUFWR0:	LD	A,0
	RLC	C			;SET/CLEAR CARRY BASED ON BIT
	ADC	A,0
	CALL	PUTBIT
	DJNZ	BUFWR0
BUFWR1:	LD	A,(HL)			;GET CHARACTER TO OUTPUT
	INC	HL
	CP	'%'			;STOP IF END OF WORD
	JR	Z,BUFWR3
	CP	0
	JR	Z,BUFWR3
	LD	B,5			;5 BITS
	CP	027H			;IS IT "'"?
	JR	NZ,NORMAL
	LD	A,'Z'+1			;IF IT IS, ENCODE AS Z+1
NORMAL:	SUB	'A'-1			;MAKE IT BASED AT 1
	LD	C,A
	RLC	C			;PUT BITS IN POSITION TO BE READ
	RLC	C
	RLC	C
BUFWR2:	LD	A,0
	RLC	C			;SET/CLEAR CARRY BASED ON BIT
	ADC	A,0
	CALL	PUTBIT
	DJNZ	BUFWR2
	JR	BUFWR1			;GET NEXT CHARACTER
BUFWR3:	LD	A,1			;MARK END OF WORD WITH 111B
	CALL	PUTBIT
	CALL	PUTBIT
	CALL	PUTBIT
	DEC	HL
	LD	D,H			;PUT POINTER TO SRCWRD IN DE
	LD	E,L
BUFWR4:	LD	A,(DE)
	CP	0			;ANY FLAGS?
	JP	Z,BUFFLG		;WRITE NULL FLAGS IF NOT
	CP	'%'			;ANOTHER FLAG?
	INC	DE
	JR	Z,BUFWR4
	CP	' '			;ILLEGAL IF SPACE
	JP	Z,BUFWR4
	LD	HL,FLGDAT		;TABLE OF FLAGS
	LD	BC,29			;14 WORD FLAGS.  IF REACHES END, ERROR.
	CPIR				;SEARCH THROUGH TABLE
	JP	PO,BUFWR4		;JUST SKIP IF ILLEGAL FLAG
	LD	BC,FLGDA0-FLGDAT-1	;OFFSET TO TABLE OF VALUES FOR FLAGS
	ADD	HL,BC			;POINT TO WORD WITH FLAG
	LD	C,(HL)			;PUT IT IN DE
	INC	HL
	LD	B,(HL)
	LD	HL,(CURFLG)		;GET CURRENT VALUE OF FLAG
	LD	A,B			;MAKE SURE FLAG NOT REPEATED
	OR	H
	LD	H,A
	LD	A,C
	OR	L
	LD	L,A
	LD	(CURFLG),HL
	JP	BUFWR4			;GET ANOTHER FLAG
BUFFLG:	LD	HL,(CURFLG)		;GET CURRENT FLAG
	CALL	PUTFLG			;OUTPUT THE FLAG
	LD	HL,0
	LD	(CURFLG),HL		;CLEAR CURRENT FLAG VALUE
	RET

PUTFLG:	LD	A,14			;FIND FIRST USED BIT
	PUSH	HL
PUTFL0:	RRC	H
	JP	C,PUTFL2		;IF BIT SET, EXIT
	DEC	A
	CP	7
	JR	NZ,PUTFL0		;LOOP THROUGH WHOLE BYTE
PUTFL1:	RRC	L
	JP	C,PUTFL2
	DEC	A
	CP	0
	JR	NZ,PUTFL1
PUTFL2:	POP	HL
	RRC	A			;PUT A IN A POSITION FOR OUTPUT
	RRC	A
	RRC	A
	RRC	A
	LD	B,4			;4 BITS
	LD	C,A
PUTFL4:	LD	A,0
	RLC	C
	ADC	A,0
	CALL	PUTBIT
	DJNZ	PUTFL4
	LD	A,C
	PUSH	PSW
	PUSH	HL
	LD	HL,(BITS)		;UPDATE NUMBER OF BITS LEFT (GREATER?)
	LD	C,A			;COMPUTE NUMBER OF BITS SAVED
	LD	A,14
	SUB	C
	LD	B,0			;UPDATE BITS
	LD	C,A
	ADD	HL,BC
	LD	(BITS),HL
	POP	HL
	POP	PSW
	CP	0			;ANY BITS TO COPY?
	RET	Z
	PUSH	PSW
	CP	8			;GREATER THAN 7?
	JP	M,PUTFM4
	LD	A,7			;DO ALL 7 BITS
PUTFM4:	LD	B,A			;NUMBER OF BITS TO COPY
	RLC	L			;GET TO FIRST BIT
PUTFL5:	LD	A,0
	RLC	L
	ADC	A,0
	CALL	PUTBIT
	DJNZ	PUTFL5
	POP	PSW
	SUB	7			;NUMBER OF BITS TO COPY IN BYTE 2
	RET	M			;RETURN IF NONE
	RET	Z
	LD	B,A
	RLC	H			;GET TO FIRST BIT
PUTFL6:	LD	A,0
	RLC	H
	ADC	A,0
	CALL	PUTBIT
	DJNZ	PUTFL6
	RET


PUTBIT:	PUSH	PSW
	PUSH	DE
	PUSH	HL
	LD	HL,CURBIT		;GET BIT INDEX
	LD	E,(HL)
	LD	HL,(CURBYT)		;ADDRESS OF CURRENT BYTE FOR OUTPUT
	PUSH	PSW
	LD	A,0111B			;MASK 1ST THREE BITS
	AND	E
	JR	NZ,PUTBI0		;IF .NE. 0 THEN NOT TIME TO INC CURBYT
	INC	HL
	LD	(CURBYT),HL
PUTBI0:	INC	E
	POP	PSW
	RLC	(HL)			;MOVE BYTE SO NEXT BIT IN RIGHT PLACE
	OR	(HL)			;PUT DESIRED BIT IN OUTPUT BUFFER
	LD	(HL),A
	LD	HL,CURBIT		;UPDATE MASK
	LD	(HL),E
	POP	HL
	POP	DE
	POP	PSW
	RET

DWRITE:	PUSH	BC
	PUSH	DE
	PUSH	HL
	LD	HL,(CURBYT)		;GET CURRENT BYTE
	LD	A,(CURBIT)		;CURRENT BIT
	LD	E,A
DWRIT0:	LD	A,0111B			;ROTATE LAST BYTE INTO PLACE
	AND	E
	JR	Z,DWRIT1
	RLC	(HL)
	INC	E
	JR	DWRIT0
DWRIT1:	LD	HL,DICBUF-1		;RESET POINTERS
	LD	(CURBYT),HL
	LD	A,0
	LD	(CURBIT),A
	LD	DE,DICBUF		;SET DMA FOR FIRST 128 BYTES
	LD	C,SETDMA
	CALL	BDOS
	LD	DE,DICFCB		;WRITE IT
	LD	C,WRITE
	CALL	BDOS
	CP	0FFH			;ERROR?
	JR	Z,DWRERR
	LD	DE,DICBUF+128		;SET DMA FOR SECOND HALF
	LD	C,SETDMA
	CALL	BDOS
	LD	DE,DICFCB		;AND WRITE IT
	LD	C,WRITE
	CALL	BDOS
	CP	0FFH			;ERROR?
	JR	Z,DWRERR
	POP	HL
	POP	DE
	POP	BC
	RET
DWRERR:	LD	DE,DSKFUL		;DISK FULL ERROR
	LD	C,STROUT
	CALL	BDOS
	CALL	BOOT
DSKFUL:	DB	'Disk full',CR,LF,'$'

MAKTBL:	PUSH	HL
	PUSH	BC
	LD	HL,DBSTR		;STRING WITH CR,LF,"	DB	'"
	LD	B,7			;7 CHARACTERS
MAKTB0:	LD	A,(HL)
	INC	HL
	CALL	PUTCHR
	DJNZ	MAKTB0
	LD	HL,SRCWRD		;WORD
	LD	B,4			;AT MOST 4 CHARACTERS GO IN TABLE
	LD	C,0			;COUNTER
MAKTB1:	LD	A,(HL)
	INC	HL
	CP	0			;END OF WORD?
	JR	Z,MAKTB2
	CP	'%'
	JR	Z,MAKTB2
	PUSH	PSW
	CALL	PUTCHR
	POP	PSW
	CP	QUOTE
	JR	NZ,MAKTBP
	CALL	PUTCHR			;"'" MUST BE SENT TWICE
MAKTBP:	INC	C
	DJNZ	MAKTB1
	LD	A,QUOTE			;"'" CHARACTER
	CALL	PUTCHR
	JR	MAKRET
MAKTB2:	LD	A,4			;GET NUMBER OF CHARACTERS LEFT TO GO
	SUB	C
	LD	B,A
	LD	A,QUOTE			;"'" CHARACTER
	CALL	PUTCHR
MAKTB3:	LD	A,','			;USE ,0 ISTEAD OF CHARACTER
	CALL	PUTCHR
	LD	A,'0'
	CALL	PUTCHR
	DJNZ	MAKTB3
MAKRET:	POP	BC
	POP	HL
	RET


GETWRD:	LD	A,0			;ZERO LENGTH
	LD	(LENGTH),A
	LD	C,0			;ZERO COUNTER
GETWS0:	CALL	GETCHR			;GET A CHARACTER
	CP	EOF			;END OF FILE?
	RET	Z
	CALL	LEGAL			;TEST IF LEGAL
	JR	Z,GETWR0		;EXIT LOOP IF LEGAL
	JR	GETWS0			;LOOP UNTIL LEGAL
GETWR0:	LD	C,1			;UPDATE CHARACTER COUNTER
	LD	HL,SRCWRD+1		;INITIALIZE POINTER TO SRCWRD:
	LD	(SRCWRD),A		;STORE FIRST CHARACTER
GETWR1:	CALL	GETCHR
	CALL	LEGAL
	JR	NZ,GETWR2		;EXIT LOOP WHEN NOT WORD CHARACTER
	LD	(HL),A
	INC	HL
	INC	C
	JR	GETWR1
GETWR2:	LD	(HL),0			;MARK END OF WORD
	LD	A,(LENGTH)		;WAS % ALREADY REACHED?
	CP	0
	RET	Z			;RETURN VALUE IN C IF NOT
	LD	C,A
	RET

LEGAL:	LD	B,A
	AND	05FH			;KILL PARITY AND LOWER CASE
	CP	'A'			;MUST BE GREATER THAN "A"
	JP	C,LEGAL0
	CP	'Z'+1			;GREATER THAN "Z"
	JP	NC,LEGAL0
	LD	A,B
	CP	A			;SET ZERO FLAG
	RET
LEGAL0:	LD	A,B
	AND	07FH			;KILL ONLY PARITY
	CP	27H			;"'"
	JR	Z,LEGAL1
	CP	'%'			;"%"
	JR	NZ,LEGAL1
	PUSH	PSW
	LD	A,(LENGTH)		;END ALREADY MARKED?
	CP	0
	JR	NZ,LEGRET
	LD	A,C
	LD	(LENGTH),A		;MARK LENGTH OF WORD
LEGRET:	POP	PSW
LEGAL1:	LD	A,B
	RET

GETCHR:	PUSH	BC
	PUSH	DE
	PUSH	HL
	LD	HL,(INPTR)		;POINTER FOR INPUT
	LD	DE,INBUF+512		;END OF INPUT BUFFER
	XOR	A			;CLEAR CARRY
	PUSH	HL
	SBC	HL,DE			;AT END OF BUFFER?
	POP	HL
	JP	Z,GETCH0		;REFILL BUFFER
	LD	A,(HL)			;GET THE CHARACTER
	AND	07FH			;KILL PARITY
	INC	HL			;INCREMENTED POINTER
	LD	(INPTR),HL
GETRET:	POP	HL
	POP	DE
	POP	BC
	RET
GETCH0:	LD	HL,INBUF
	LD	DE,128
	LD	C,4
GETCH2:	PUSH	BC
	PUSH	DE
	PUSH	HL
	LD	A,01AH			;MARK START OF RECORD WITH EOF IN CASE
					;EOF
	LD	(HL),A
	INC	HL
	LD	(HL),A
	DEC	HL
	LD	D,H			;SET UP DMA ADDRESS FOR READ
	LD	E,L
	LD	C,SETDMA
	CALL	BDOS			;SET DMA ADDRESS
	LD	DE,IFCB
	LD	C,READ			;READ 128 BYTES OF INPUT FILE
	CALL	BDOS
	POP	HL
	POP	DE
	POP	BC
	CP	0			;SUCCESS?
	JR	NZ,GETCH3		;JUMP IF EOF
	ADD	HL,DE			;POINT TO NEXT RECORD ADDRESS
	DEC	C
	JP	NZ,GETCH2		;LOOP FOR 4 RECORDS
GETCH3:	LD	A,(INBUF)		;GET FIRST CHARACTER
	LD	(HL),EOF		;PUT EOF AT BEGINNING OF FIRST UNUSED
					;RECORD IN MEMORY
	LD	HL,INBUF+1
	LD	(INPTR),HL		;SET UP POINTER TO RECORDS
	JP	GETRET

DICZER:	PUSH	PSW
	PUSH	BC
	PUSH	HL
	LD	B,0
	LD	A,0
	LD	HL,DICBUF
DICZE0:	LD	(HL),A
	INC	HL
	DJNZ	DICZE0
	POP	HL
	POP	BC
	POP	PSW
	RET



PUTCHR:	PUSH	BC
	PUSH	DE
	PUSH	HL
	LD	HL,(OPOSS)		;GET CURRENT POSITION IN OBUFF
	LD	(HL),A			;PUT CHARACTER IN BUFFER
	INC	HL
	LD	(OPOSS),HL		;UPDATE POINTER
	LD	DE,OBUFF+512		;AT END OF BUFFER?
	XOR	A			;CLEAR CARRY
	SBC	HL,DE
	JR	Z,PUTCH0		;WRITE OUT DATA IF END OF BUFFER
PUTRET:	POP	HL
	POP	DE
	POP	BC
	RET
PUTCH0:	LD	C,4			;LOOP COUNTER
	LD	HL,OBUFF		;ADDRESS OF DATA
	LD	DE,128			;LENGTH OF EACH RECORD
PUTCH1:	PUSH	BC
	PUSH	DE
	PUSH	HL
	LD	D,H			;SET UP DMA ADDRESS
	LD	E,L
	LD	C,SETDMA
	CALL	BDOS
	LD	DE,OFCB			;WRITE RECORD TO OUTPUT FILE
	LD	C,WRITE
	CALL	BDOS
	CP	0			;SUCCESS?
	JR	NZ,PUTCH2		;JUMP IF DISK FULL
	POP	HL
	POP	DE
	POP	BC
	ADD	HL,DE			;POINT TO NEXT RECORD
	DEC	C
	JP	NZ,PUTCH1		;LOOP FOR 512 BYTE BUFFER
	LD	HL,OBUFF		;RESET POINTER
	LD	(OPOSS),HL
	CALL	CTRLZ			;FILL BUFFER WITH EOF CHARACTER
	JP	PUTRET			;RETURN
PUTCH2:	LD	C,STROUT		;DISK FULL ERROR
	LD	DE,DSKFUL
	CALL	BDOS
	CALL	BOOT			;GIVE UP

CTRLZ:	LD	HL,OBUFF		;BUFFER ADDRESS
	LD	B,2			;LOOP 256 BYTES 2 TIMES
	LD	C,0
CTRLZ0:	LD	(HL),EOF		;PUT EOF IN BUFFER
	INC	HL
	DEC	C			;FAST COUNTER
	JR	NZ,CTRLZ0
	DEC	B			;SLOW COUNTER
	JR	NZ,CTRLZ0
	RET

YESNO:	LD	C,6			;DIRECT CONSOLE I/O
	LD	E,0FFH			;INPUT
	CALL	BDOS
	AND	05FH			;MAKE UPPER CASE
	CP	0			;NO CHARACTER YET?
	JR	Z,YESNO
	CP	'Y'			;YES?
	JR	Z,YESNO1
	CP	'N'
	JR	Z,YESNO2
	LD	C,6			;RING THE BELL (BAD INPUT)
	LD	E,7
	CALL	BDOS
	JR	YESNO			;TRY AGAIN
YESNO1:	LD	DE,YESSTR		;ECHO Y
	LD	A,0			;INDICATE YES
	JR	YESNO3
YESNO2:	LD	DE,NOSTR		;ECHO N
	LD	A,1			;INDICATE NO
YESNO3:	LD	C,STROUT
	PUSH	PSW
	CALL	BDOS
	POP	PSW
	AND	A
	RET



INPTR:	DW	INBUF+512
CURBYT:	DW	DICBUF-1
CURBIT:	DB	0
CURFLG:	DW	0
BITS:	DW	256*8
LENGTH:	DB	0
OPOSS:	DW	OBUFF

EXDIC:	DB	'Delete current version of DICT.DIC? $'
EXSPEL:	DB	'Delete current version of SPELL0.MAC? $'
YESSTR:	DB	'Y',CR,LF,'$'
NOSTR:	DB	'N',CR,LF,'$'
TYPECR:	DB	'Insert a bootable disk in drive A and type CR$'
MOREST:	DB	'More? (if Y, insert new disk in input drive) $'

DICFCB:	DB	0,'DICT    DIC'
	DB	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
OFCB:	DB	0,'SPELL0  MAC'
	DB	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

TABTOP:	DB	'TABTOP::'
TBTSTR:	DB	CR,LF,'	DB	',QUOTE,'[[[[',QUOTE,CR,LF,'TABBOT::',CR,LF
DBSTR:	DB	CR,LF,'	DB	',QUOTE
FLGDAT:	DB	'Z Y R G D M S H V J X T N P '
FLGDA0:	DW	ZFLAG
	DW	YFLAG
	DW	RFLAG
	DW	GFLAG
	DW	DFLAG
	DW	MFLAG
	DW	SFLAG
	DW	HFLAG
	DW	VFLAG
	DW	JFLAG
	DW	XFLAG
	DW	TFLAG
	DW	NFLAG
	DW	PFLAG

OLDWRD:	DB	0FFH
STACK	EQU	$+50
SRCWRD	EQU	STACK+80
INBUF	EQU	SRCWRD+80
OBUFF	EQU	INBUF+514
DICBUF	EQU	OBUFF+513
NEXT	EQU	DICBUF+256
	END	START
